perm filename CARF1.SAI[AER,HPM]2 blob
sn#168752 filedate 1975-07-12 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "CARF1"
C00006 ENDMK
C⊗;
BEGIN "CARF1"
REQUIRE "VIXNIC.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "CARR.SAI[AER,HPM]" SOURCE_FILE;
INTEGER I,J,K,L,M,N,PSIZ,DCHAN,PSIZ2;
STRING FN;
BOOLEAN SYNA;
DO OUTSTR("PICTURE:") UNTIL (PSIZ←PFLDIM(FN←INCHWL))≠0;
BEGIN
INTEGER ARRAY PA[0:PSIZ];
GETPFL(FN,PA[0]);
PSIZ2←PIXDIM(PA[PCLN]%2,PA[LNBY]%2,PA[BYBI]);
END;
DDINIT;
SCREEN(-.5,1.5,1.5,-.5);
DRKEN; RECTAN(-1000,-1000,1000,1000);
FOR I←0 STEP 1 UNTIL 5 DO FOR J←0,0,0,0 DO DPYUP(SYNMAP(I));
SHOWA('47);
BEGIN
INTEGER ARRAY PA[0:PSIZ2];
INTEGER BITS;
BEGIN
INTEGER ARRAY PB[0:PSIZ];
GETPFL(FN,PB[0]);
MAKPIX(PB[PCLN]%2,PB[LNBY]%2,PB[BYBI],PA[0]);
SELECT(PB[0],PB[PCLN]%2,PB[LNBY]%2,PA[0]);
END;
BITS←PA[BYBI];
FOR I←1 STEP 1 UNTIL (BITS MIN 5) DO
BEGIN
INTEGER XP,YP,DBIT;
DBIT←BITS-I;
DRKEN; RECTAN(0,0,1,1);
VIDEO(0,0,1,1,PA[0],1 ASH DBIT);
FOR J←1,2,3 DO DPYUP(SYNMAP(5-I));
SHOWA('47);
END;
BEGIN
REAL ARRAY QC[0:PA[PCLN]-CARH12,0:PA[LNBY]-CARW12];
INTEGER XL,XH,YL,YH; REAL AVRG,LOA,HIA;
XL←0; YL←0; XH←PA[LNBY]-1; YH←PA[PCLN]-1;
outstr("into vcar"&'15&'12);
AVRG←VCAR(PA[0],XL,YL,XH,YH,QC[0,0]);
outstr("out of vcar"&'15&'12);
PUTPFL(PA[0],"A");
AVRG←0;
FOR I←0 STEP 1 UNTIL PA[PCLN]-CARH12 DO
FOR J←0 STEP 1 UNTIL PA[LNBY]-CARW12 DO
BEGIN
IF QC[I,J]>1.0∨QC[I,J]<0 THEN OUTSTR(CVF(QC[I,J])&" ");
QC[I,J]←QC[I,J] MAX 0;
HIA←HIA MAX QC[I,J];
LOA←LOA MIN QC[I,J];
END;
AVRG←HIA/(2↑PA[BYBI]-2);
FOR I←100 STEP 1 UNTIL PSIZ2 DO PA[I]←0;
MAKPIX(PA[PCLN],PA[LNBY],PA[BYBI],PA[0]);
FOR I←0 STEP 1 UNTIL PA[PCLN]-CARH12 DO
FOR J←0 STEP 1 UNTIL PA[LNBY]-CARW12 DO
PUTEL(PA[0],I+CARH12%2,J+CARW12%2,2↑PA[BYBI]-2-QC[I,J]/AVRG);
PUTPFL(PA[0],"B");
DRKEN; RECTAN(-1000,-1000,1000,1000);
VIDEO(0,0,1,1,PA[0],(1 ASH 2↑PA[BYBI])%2);
FOR J←1,1,1 DO DPYUP(SYNMAP(5));
SHOW('47);
END;
END;
END;